home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
ins_msb
/
9005
/
fcblabel.bas
< prev
next >
Wrap
BASIC Source File
|
1990-05-01
|
4KB
|
169 lines
'PROGRAM - FCBLABEL.BAS
'Microsoft BASIC module for manipulating volume
'labels
'BASIC Version 7.0 users should change the next
'line to use the QBX.BI file
'$INCLUDE: 'QB.BI'
'$INCLUDE: 'FCBLABEL.BI'
TYPE ExtendedFCBRecord
ExtFCB AS STRING * 1
Res1 AS STRING * 5
Attr AS STRING * 1
Drive AS STRING * 1
Name1 AS STRING * 11
Unused1 AS STRING * 5
Name2 AS STRING * 11
Unused2 AS STRING * 9
END TYPE
FUNCTION DeleteDiskID% (Drive$)
DIM EFCB AS ExtendedFCBRecord
DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX
EFCB.ExtFCB = CHR$(&HFF) 'Set EFCB flag
EFCB.Attr = CHR$(&H8) 'Vol label attribute
EFCB.Drive = CHR$(ASC(Drive$) - 64)
EFCB.Name1 = "*.* "
InRegsX.ax = &H1300 'Call find first FCB
InRegsX.ds = VARSEG(EFCB) 'Load DS:DX with
InRegsX.dx = VARPTR(EFCB) 'address of EFCB
CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
'Set error codes
IF Lo(OutRegsX.ax) = 0 THEN 'Successful
DeleteDiskID = -1 'True
ELSE
DeleteDiskID = 0 'False
END IF
END FUNCTION
FUNCTION GetDiskID$ (Drive$)
DIM EFCB AS ExtendedFCBRecord
DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX
' Get Address of Data Transfer Area (DTA)
CALL GetDTAAddr(Segment, Offset)
' Call the Find First FCB function
' using the Volume attribute
EFCB.ExtFCB = CHR$(&HFF) 'Set EFCB flag
EFCB.Attr = CHR$(&H8) 'Vol label attribute
EFCB.Drive = CHR$(ASC(Drive$) - 64)
EFCB.Name1 = "*.* "
InRegsX.ax = &H1100 'Call find first FCB
InRegsX.ds = VARSEG(EFCB) 'Load DS:DX with
InRegsX.dx = VARPTR(EFCB) 'address of EFCB
CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
GetDiskID$ = ""
IF Lo(OutRegsX.ax) = 0 THEN 'Successful
VOL$ = ""
DEF SEG = Segment 'Set Segment to DTA
FOR I = Offset + 8 TO Offset + 18
VOL$ = VOL$ + CHR$(PEEK(I))
NEXT I
DEF SEG
GetDiskID$ = VOL$
END IF
END FUNCTION
SUB GetDTAAddr (Segment, Offset)
DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX
InRegsX.ax = &H2F00
CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
Segment = OutRegsX.es 'Return address of DTA
Offset = OutRegsX.bx 'Segment:Offset format
END SUB
FUNCTION Lo (IntegerVar)
Lo = IntegerVar MOD 256
END FUNCTION
FUNCTION RenameDiskID_
(Drive$, OldDiskID$, NewDiskID$)
DIM EFCB AS ExtendedFCBRecord
DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX
'EFCB setup
EFCB.ExtFCB = CHR$(&HFF) 'Set EFCB flag
EFCB.Attr = CHR$(&H8) 'Vol label attribute
EFCB.Drive = CHR$(ASC(Drive$) - 64)
'Rename specific instructions
L = LEN(OldDiskID$)
IF L < 11 THEN
OldDiskID$ = OldDiskID$ + SPACE$(11 - L)
END IF
EFCB.Name1 = OldDiskID$
L = LEN(NewDiskID$)
IF L < 11 THEN
NewDiskID$ = NewDiskID$ + SPACE$(11 - L)
END IF
EFCB.Name2 = NewDiskID$
' Call Service 17H to RENAME a volume label
InRegsX.ax = &H1700 'Call find first FCB
InRegsX.ds = VARSEG(EFCB) 'Load DS:DX with
InRegsX.dx = VARPTR(EFCB) 'address of EFCB
CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
'Set error codes
IF Lo(OutRegsX.ax) = 0 THEN 'Successful
RenameDiskID = -1 'True
ELSE
RenameDiskID = 0 'False
END IF
END FUNCTION
FUNCTION SetDiskID (Drive$, VolumeName$)
DIM EFCB AS ExtendedFCBRecord
DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX
CALL GetDTAAddr(Segment, Offset)
' Call the Find First FCB function
' using the Volume attribute
EFCB.ExtFCB = CHR$(&HFF) 'Set EFCB flag
EFCB.Attr = CHR$(&H8) 'Vol label attribute
EFCB.Drive = CHR$(ASC(Drive$) - 64)
L = LEN(VolumeName$)
IF L < 11 THEN
VolumeName$ = VolumeName$ + SPACE$(11 - L)
END IF
EFCB.Name1 = VolumeName$
InRegsX.ax = &H1600 'Call find first FCB
InRegsX.ds = VARSEG(EFCB) 'Load DS:DX with
InRegsX.dx = VARPTR(EFCB) 'address of EFCB
CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
IF Lo(OutRegsX.ax) = 0 THEN 'Successful
SetDiskID = -1 'True
ELSE
SetDiskID = 0 'False
END IF
END FUNCTION